home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DIALOGS / JANUSW / VBXDEMO2.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-14  |  5KB  |  195 lines
  1. { Program:   VbxDemo2
  2.   Version:   1.0
  3.   Purpose:   Demo program to show use of dynamically created VBX custom controls
  4.   Date:      12 March 1994
  5.   Developer: Frank Lees (FL)
  6.              Phoenix, Arizona
  7.   CompuServe: 71532,2133
  8.  
  9.  
  10.  Copyright (c) 1994 Frank Lees, Peter Sawatzki. All Rights Reserved.
  11. }
  12. Program VbxDemo2;
  13. {$R VbxDemo2.Res}
  14. Uses
  15.   WinProcs,
  16.   oWindows,
  17.   oDialogs,
  18.   WinTypes,
  19.   Strings,
  20.   ThreeD,   { VBX Definition - Generated by VBXInfo }
  21.   Grid,     { VBX definition - Generated by VBXInfo }
  22.   Vbx;      { Interface to BIVBX10.DLL }
  23.  
  24. Const
  25.   VBXvalidation: tVbxValidation = cVbxValidation;
  26.  
  27. type { derived object against TPanel generated by VBXINFO }
  28.   PMyPanel =^TMyPanel;
  29.   TMyPanel = object(TSSPanel)
  30.     procedure SetupWindow; virtual;
  31.   end;
  32.  
  33. type { derived object against TGrid generated by VBXINFO }
  34.   PMyGrid =^TMyGrid;
  35.   TMyGrid = object(TGrid)
  36.     procedure SetupWindow; virtual;
  37.     Procedure evClick     (Var Event: tVbxEvent); Virtual ev_First+0;
  38.     Procedure evSelChange (Var Event: tVbxEvent); Virtual ev_First+13;
  39.   end;
  40.  
  41. type { Main Window }
  42.   pMyWindow = ^tMyWindow;
  43.   tMyWindow = Object(tVbxWindow)
  44.     ctl1: PMyPanel;
  45.     ctl2: PMyGrid;
  46.     btBusy,btFree: PButton;
  47.     Constructor Init (aParent: pWindowsObject; Name: pChar);
  48.     Procedure SetupWindow; Virtual;
  49.   End;
  50.  
  51. procedure TMyPanel.SetupWindow;
  52. {- Setup 3D Panel }
  53. var
  54.   x,y:integer;
  55.   fs: Single;
  56. const
  57.   GRIDROWS=20;
  58.   GRIDCOLS=8;
  59.   DayTab:array[1..7] of PChar = ('Mon','Tue','Wed','Thu','Fri','Sat','Sun');
  60.  
  61. begin
  62.   inherited SetupWindow;
  63.   SetPropAlignment(aCenterMiddle);
  64.   SetPropBorderWidth(1);
  65.   SetPropBevelWidth(3);
  66.   SetPropBevelOuter(boInset);
  67.   SetPropBevelInner(biInset);
  68.   SetPropCaption('Appointments');
  69.   SetPropFontName('Arial');
  70.   GetPropFontSize(fs);
  71.   WriteLn('Font Size= ',fs:10:3);
  72.   SetPropFontSize(240);
  73.   SetPropFontBold(TRUE);
  74.   SetPropFont3d(fdInsetwlightshading);
  75.   SetPropFontUnderLine(FALSE);
  76.   SetPropFontStrikeThru(FALSE);
  77.  
  78.   SetPropBackColor(RGB(192,192,192));
  79. end;
  80.  
  81. procedure TMyGrid.SetupWindow;
  82. {- Setup Grid Control }
  83. var
  84.   x,y:integer;
  85.   pHour: array[0..5] of char;
  86. const
  87.   GRIDROWS=25;
  88.   GRIDCOLS=8;
  89.   DayTab:array[1..7] of PChar = ('Mon','Tue','Wed','Thu','Fri','Sat','Sun');
  90. begin
  91.   inherited SetupWindow;
  92.   Exit;
  93.   SetPropRows(GRIDROWS);
  94.   SetPropCols(GRIDCOLS+1);
  95.   SetPropBackColor(RGB(0,255,0));
  96.   SetPropByName('Scrollbars',3);
  97.  
  98.   { Grid Headings }
  99.   SetPropRow(0);
  100.   for x:=1 to GRIDCOLS+1 do
  101.     begin
  102.       SetPropCol(x);
  103.       SetPropText(Daytab[x]);
  104.       SetPropFontBold(FALSE);
  105.     end;
  106.  
  107.   SetPropCol(0);
  108.   for x:=1 to GRIDROWS-1 do
  109.     begin
  110.       SetPropRow(x);
  111.       WVSprintf(pHour,'%02i:00',x);
  112.       SetPropText(pHour);
  113.       SetPropFontBold(FALSE);
  114.     end;
  115.  
  116.   for x:=1 to GridRows-1 do
  117.     for y:=1 to GridCols-1 do
  118.       begin
  119.         SetPropRow(x);
  120.         SetPropCol(y);
  121.         SetPropText('Free');
  122.       end;
  123.  
  124.    { Load a Bitmap and an icon into the grid }
  125.    SetPropRow(0);
  126.    SetPropCol(0);
  127.    SetPropPicture(dVbx.LoadPicture('BM1',PICTYPE_BITMAP));
  128. {
  129.   for x:=1 to 7 do
  130.     begin
  131.       SetPropByName('Row',x); SetPropByName('Col',x);
  132.       SetPropPicture(LoadPicture('IC1',PICTYPE_ICON));
  133.    end;
  134.  }
  135. end;
  136.  
  137. procedure TMyGrid.evClick(Var Event: tVBXEvent);
  138. begin
  139. {  MessageBox(0,'Click','',mb_ok);    }
  140. end;
  141.  
  142. Procedure TMyGrid.evSelChange (Var Event: tVbxEvent);
  143. var
  144.   x1,x2,y1,y2: integer;
  145. begin
  146.   GetPropSelStartRow (y1);
  147.   GetPropSelEndRow (y2);
  148.   GetPropSelStartCol(x1);
  149.   GetPropSelEndCol(x2);
  150. end;
  151.  
  152.  
  153. Procedure tMyWindow.SetupWindow;
  154. Begin
  155.   Inherited SetupWindow;
  156. End;
  157.  
  158. Constructor tMyWindow.Init (aParent: pWindowsObject; Name: pChar);
  159. Begin
  160.   inherited Init(aParent,Name);
  161.   Attr.W:=500;
  162.   Attr.H:=450;
  163.   ctl1:=new(PMyPanel,Init(@self,100,'Panel100',10,10,300,75,0,NIL));
  164.   ctl2:=new(PMyGrid,Init(@self,101,'Grid101',10,120,380,250,0,NIL));
  165.   btFree:=new(PButton,Init(@self,500,'&Free',420,150,50,20,FALSE));
  166.   btBusy:=new(PButton,Init(@self,501,'&Busy',420,200,50,20,FALSE));
  167.  
  168. End;
  169.  
  170.  
  171. {-------------------- the Application part }
  172. Const
  173.   ProgName = 'VbxDemo2';
  174. Type
  175.   tProgApp = Object(tApplication)
  176.     Procedure InitMainWindow; Virtual;
  177.   End;
  178.  
  179. Procedure tProgApp.InitMainWindow;
  180. Begin
  181.   MainWindow:= New(pMyWindow, Init(Nil, 'Dynamically Created VBX Control Demo'))
  182. End;
  183.  
  184. Var
  185.   App: tProgApp;
  186. Begin
  187.   RegisterVBX(VBXvalidation);
  188.   With App Do Begin
  189.     Init(ProgName);
  190.     Run;
  191.     Done
  192.   End
  193. End.
  194.  
  195.